home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 1: Comms & Networking / Almathera Ten on Ten - Disc 1: Comms & Networking.iso / amiga-useful / perl / t / test < prev    next >
Text File  |  1995-05-04  |  2KB  |  100 lines
  1. # $RCSfile: TEST,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:59:30 $
  2.  
  3. # This is written in a peculiar style, since we're trying to avoid
  4. # most of the constructs we'll be testing for.
  5.  
  6. $| = 1;
  7.  
  8. if ($ARGV[0] eq '-v') {
  9.     $verbose = 1;
  10.     shift;
  11. }
  12.  
  13. if ($ARGV[0] eq '') {
  14.     @ARGV = split(/[ \n]/,
  15.       `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
  16. }
  17.  
  18. #open(CONFIG,"../config.sh");
  19. #while (<CONFIG>) {
  20. #    if (/sharpbang='(.*)'/) {
  21. #    $sharpbang = ($1 eq '#!');
  22. #    last;
  23. #    }
  24. #}
  25. $sharpbang = 0;
  26. $bad = 0;
  27. while ($test = shift) {
  28.     if ($test =~ /^$/) {
  29.     next;
  30.     }
  31.     $te = $test;
  32.     chop($te);
  33.     print "$te" . '.' x (15 - length($te));
  34.     if ($sharpbang) {
  35.     open(results,"./$test|") || (print "can't run.\n");
  36.     } else {
  37.     open(script,"$test") || die "Can't run $test.\n";
  38.     $_ = <script>;
  39.     close(script);
  40.     if (/#!..perl(.*)/) {
  41.         $switch = $1;
  42.     } else {
  43.         $switch = '';
  44.     }
  45.     open(results,"perl$switch $test|") || (print "can't run.\n");
  46.     }
  47.     $ok = 0;
  48.     $next = 0;
  49.     while (<results>) {
  50.     if ($verbose) {
  51.         print $_;
  52.     }
  53.     unless (/^#/) {
  54.         if (/^1\.\.([0-9]+)/) {
  55.         $max = $1;
  56.         $totmax += $max;
  57.         $files += 1;
  58.         $next = 1;
  59.         $ok = 1;
  60.         } else {
  61.         $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  62.         if (/^ok (.*)/ && $1 == $next) {
  63.             $next = $next + 1;
  64.         } else {
  65.             $ok = 0;
  66.         }
  67.         }
  68.     }
  69.     }
  70.     $next = $next - 1;
  71.     if ($ok && $next == $max) {
  72.     print "ok\n";
  73.     } else {
  74.     $next += 1;
  75.     print "FAILED on test $next\n";
  76.     $bad = $bad + 1;
  77.     $_ = $test;
  78.     if (/^base/) {
  79.         die "Failed a basic test--cannot continue.\n";
  80.     }
  81.     }
  82. }
  83.  
  84. if ($bad == 0) {
  85.     if ($ok) {
  86.     print "All tests successful.\n";
  87.     } else {
  88.     die "FAILED--no tests were run for some reason.\n";
  89.     }
  90. } else {
  91.     if ($bad == 1) {
  92.     die "Failed 1 test.\n";
  93.     } else {
  94.     die "Failed $bad tests.\n";
  95.     }
  96. }
  97. ($user,$sys,$cuser,$csys) = times;
  98. print sprintf("u=%g  s=%g  cu=%g  cs=%g  files=%d  tests=%d\n",
  99.     $user,$sys,$cuser,$csys,$files,$totmax);
  100.